unit QBTheme;

interface

{$I QBuilderVerCtrl.inc}

uses
  {$IFDEF VCL16}
    Winapi.Windows,
    System.SysUtils,
    Winapi.Messages,
    Vcl.Dialogs;
  {$ELSE}
    Windows,
    SysUtils,
    Messages,
    Dialogs;
  {$ENDIF}

type
  TThemeChangedNotificator = class
    FWindowHandle: HWND;
    procedure WndProc(var Msg: TMessage);
    procedure WMThemeChanged(var Message: TMessage); message $031A;
    constructor Create;
    destructor Destroy; override;
  end;

  TDrawThemeBackground = function(hTheme: THandle; DC: HDC; iPartId, iStateId: Integer;
    pRect: PRect; pClipRect: PRect = nil): HRESULT; stdcall;
  TCloseThemeData = function(hTheme: THandle): HRESULT; stdcall;
  TOpenThemeData = function(hWnd: HWND; pszClassList: PWideChar): THandle; stdcall;
  TDrawThemeText = function(hTheme: THandle; DC: HDC; iPartId, iStateId: Integer;
    pszText: PWideChar; iCharCount: Integer; dwTextFlags, dwTextFlags2: DWORD;
    pRect: PRect): HRESULT; stdcall;

const
  WP_MDIMINBUTTON = 16;
  WP_MDIRESTOREBUTTON = 22;
  WP_MDICLOSEBUTTON = 20;
  MINBS_PUSHED = 3;
  MINBS_NORMAL = 1;
  MINBS_HOT = 2;
  TC_NONE = 0;
  FS_INACTIVE = 2;
  FS_ACTIVE = 1;
  WP_CAPTION = 1;
  WP_FRAMELEFT = 7;
  WP_FRAMERIGHT = 8;
  WP_FRAMEBOTTOM = 9;
  WP_SMALLCAPTION = 2;

var
  UseXPTheme: boolean;
  ThemeNotificator: TThemeChangedNotificator;
  Theme: THandle;
  FThemeLibrary: HMODULE;
  FDrawThemeBackground: TDrawThemeBackground;
  FOpenThemeData: TOpenThemeData;
  FCloseThemeData: TCloseThemeData;
  FDrawThemeText: TDrawThemeText;

function DrawThemeBackground(hTheme: THandle; DC: HDC; iPartId, iStateId: Integer;
  pRect: TRect; pClipRect: PRect = nil): HRESULT;
function OpenTheme: THandle;
function CloseTheme: HRESULT;
function AreVisualStylesAvailable: Boolean;
function DrawThemeText(hTheme: THandle; DC: HDC; iPartId, iStateId: Integer;
  pszText: PWideChar;
  iCharCount: Integer; dwTextFlags, dwTextFlags2: DWORD;
  const pRect: PRect): HRESULT;

implementation
uses
  {$IFDEF VCL16}
    System.Classes,
    Vcl.Forms;
  {$ELSE}
    Classes,
    Forms;
  {$ENDIF}

function DrawThemeText(hTheme: THandle; DC: HDC; iPartId, iStateId: Integer;
  pszText: PWideChar;
  iCharCount: Integer; dwTextFlags, dwTextFlags2: DWORD;
  const pRect: PRect): HRESULT;
begin
  Result := FDrawThemeText(hTheme, DC, iPartId, iStateId,
    pszText, iCharCount, dwTextFlags, dwTextFlags2, pRect);
end;

function DrawThemeBackground(hTheme: THandle; DC: HDC; iPartId, iStateId: Integer;
  pRect: TRect; pClipRect: PRect = nil): HRESULT;
begin
  Result := FDrawThemeBackground(hTheme, DC,
    iPartId, iStateId, @pRect, pClipRect);
end;

function OpenThemeData(hWnd: HWND; pszClassList: PWIDECHAR): THandle;
begin
  Result := FOpenThemeData(hWnd, pszClassList);
end;

function CloseThemeData(hTheme: THandle): HRESULT;
begin
  Result := FCloseThemeData(hTheme);
end;

function IsThemeLibraryLoaded: Boolean;
begin
  Result := FThemeLibrary <> 0;
end;

function AreVisualStylesAvailable: Boolean;
begin
  Result := IsThemeLibraryLoaded and (OpenTheme <> TC_NONE);
end;

function OpenTheme: THandle;
begin
  //    Result := 0;
  //    if not AreVisualStylesAvailable then Exit;
  Result := OpenThemeData(0, 'Window');
  Theme := Result;
end;

function CloseTheme: HRESULT;
begin
  Result := S_FALSE;
  if not AreVisualStylesAvailable then
    Exit;
  //    Result := S_OK;
  Result := CloseThemeData(Theme);
end;

{ TThemeChangedNotificator }

constructor TThemeChangedNotificator.Create;
begin
  inherited Create;
{$IFDEF VCL6}
  FWindowHandle := {$IFDEF VCL16}System.Classes{$ELSE}Classes{$ENDIF}.AllocateHWnd(WndProc);
{$ELSE}
  FWindowHandle := Forms.AllocateHWnd(WndProc);
{$ENDIF}
end;

destructor TThemeChangedNotificator.Destroy;
begin
{$IFDEF VCL6}
  {$IFDEF VCL16}System.Classes{$ELSE}Classes{$ENDIF}.DeallocateHWnd(FWindowHandle);
{$ELSE}
  Forms.DeallocateHWnd(FWindowHandle);
{$ENDIF}
  inherited Destroy;
end;

procedure TThemeChangedNotificator.WMThemeChanged(var Message: TMessage);
begin
  CloseTheme;
  Theme := OpenTheme;
end;

procedure TThemeChangedNotificator.WndProc(var Msg: TMessage);
begin
  with Msg do
    if Msg = $031A then
    try
      CloseTheme;
      DefWindowProc(FWindowHandle, Msg, wParam, lParam);
    except
      Application.HandleException(Self);
    end
    else
      Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;

initialization
  FThemeLibrary := LoadLibrary('UxTheme.dll');
  if FThemeLibrary <> 0 then
  begin
    FDrawThemeBackground := GetProcAddress(FThemeLibrary, 'DrawThemeBackground');
    FCloseThemeData := GetProcAddress(FThemeLibrary, 'CloseThemeData');
    FDrawThemeText := GetProcAddress(FThemeLibrary, 'DrawThemeText');
    FOpenThemeData := GetProcAddress(FThemeLibrary, 'OpenThemeData');
    Theme := OpenTheme; // iplus
    ThemeNotificator := TThemeChangedNotificator.Create; // iplus
  end;
finalization
  ThemeNotificator.Free; // iplus
end.
